perm filename PRCAUX.SAI[AL,HE] blob sn#290115 filedate 1977-06-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	PROCESS AUXILIARIES
C00003 00003	! Command, new_command
C00005 00004	! crcall
C00006 00005	! tresume,prcerr
C00007 00006	! rec_resume
C00008 ENDMK
C⊗;
COMMENT PROCESS AUXILIARIES;

ENTRY;

BEGIN "PRCAUX"


REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "MACROS.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "IOMODX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "SYS:PROCES.DEF" SOURCE_FILE;
REQUIRE "LEPAUX.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "REFBTS.DEF[AL,HE]" SOURCE_FILE;
REQUIRE "PRCAUX.HDR[AL,HE]" SOURCE_FILE;

! Command, new_command;

INTERNAL RECORD_CLASS COMMAND(ITEMVAR OP;
				RECORD_POINTER(ANY_CLASS) REC;
				INTEGER INT);

INTERNAL RECORD_POINTER(COMMAND) PROCEDURE NEW_COMMAND(
				ITEMVAR OP;
				RECORD_POINTER(ANY_CLASS) REC(NULL_RECORD);
				INTEGER INT(0));
	BEGIN
	RECORD_POINTER(COMMAND) NC;
	NC←NEW_RECORD(COMMAND);
	COMMAND:OP[NC]←OP;
	COMMAND:REC[NC]←REC;
	COMMAND:INT[NC]←INT;
	RETURN(NC);
	END;

INTERNAL PROCEDURE MK_STDCMD(REFERENCE ITEMVAR IDI;
		    REFERENCE RECORD_POINTER(COMMAND) IDR;
		    STRING ID);
	BEGIN
	IDR←NEW_RECORD(COMMAND);
	COMMAND:OP[IDR]←IDI←NEW(IDR);
	NEW_PNAME(IDI,ID);
	END;

STDCMD(INTERNAL,OK);	! a common result;
STDCMD(INTERNAL,LOSER);	! a common result;
STDCMD(INTERNAL,DIE); 	! go commit suicide;

STDCMD(INTERNAL,GET_STATUS,GTSTS); ! asks for internal status info 
					(may have various meanings);

STDCMD(INTERNAL,GET_NEXT,GTNXT); ! asks for next element from record generator;

! crcall;

INTERNAL SIMPLE BOOLEAN PROCEDURE CRCALL;
	START_CODE
	EXTERNAL INTEGER SPROUT;
	MOVE	1,('12); ! dyn link of caller;
	HLRZ	1,1(1); ! look at pda of this guy;
	HRRZ	1,(1);
	CAIE	1,SPROUT; ! unfortunately, SPRPDA may move;
	TDZA	1,1;
	MOVEI	1,1;
	END;

! tresume,prcerr;

INTERNAL ITEMVAR SIMPROC TRESUME(ITEMVAR P,V;INTEGER OPT(0));
	BEGIN
	PRINT(" PROCESS ",MYPROC," DOES RESUME(",P,",",V,",'",CVOS(OPT),")"&CRLF);
	V←RESUME(P,V,OPT);
	PRINT(" PROCESS ",MYPROC," RESUMED WITH VALUE ",V,CRLF);
	RETURN(V);
	END;

INTERNAL SIMPROC PRCERR(STRING MSG);
	BEGIN
	INTEGER CTL;
	CTL←GETPRINT;
	SETPRINT(NULL,"C");
	PRINT("PROCESS ",MYPROC," ERROR:"&CRLF);
	PRINT(MSG,CRLF);
	IF CTL="F" ∨ CTL="N" ∨ CTL="S" THEN SETPRINT(NULL,"I");
	USERERR(1,1,NULL);
	END;
! rec_resume;

INTERNAL RECORD_POINTER(ANY_CLASS)
		RECURSIVE PROCEDURE REC_RESUME(ITEMVAR PRC;
				RECORD_POINTER(ANY_CLASS) REC(NULL_RECORD);
				INTEGER OPTS(0));
	BEGIN
	RECORD_POINTER(ANY_CLASS) ITEMVAR RI;
	RI←RESUME(PRC,NEW(REC),OPTS);
	IF RI=ANY∨RI=BINDIT THEN 
		RETURN(NULL_RECORD);
	IF TYPEIT(RI)≠REC_CODE THEN
		BEGIN
		PRCERR("REC_RESUME ("&ITMNAM(PRC)
			&") FAILED TO PRODUCE A RECORD ITEM.  "
			&ITMNAM(RI)&"WAS RETURNED INSTEAD");
		RETURN(NULL_RECORD);
		END;
	REC←∂(RI);
	DELETE(RI);
	RETURN(REC);
	END;

END "PRCAUX"